Optional linked-lists.f

Requires Structs
Requires Tools

Only Forth Definitions

\ Single link lists

-? : linked-list:
   create 0 , ;

-? : add-link   ( object object-link list -- )
   dup @ rot ! ! ;

\ Double link heirarchical lists

Struct
   cell field ->parent
   cell field ->first
   cell field ->last
   cell field ->prev
   cell field ->next
\   cell field ->object
End-struct /Node

: remove-node   ( node -- )
   dup ->parent @ ?dup 0= if drop exit then
   locals| parent obj |
   obj ->prev @ ?dup if
      obj ->next @ swap ->next !
   else
      obj ->next @ parent ->first !
   then
   obj ->next @ ?dup if
      obj ->prev @ swap ->prev !
   else
      obj ->prev @ parent ->last !
   then
   obj ->parent off ;

: link-node ( node dest -- )
   over remove-node
   dup ->parent @ locals| parent dest node |
   dest node ->prev !    dest ->next @ node ->next !
   dest ->next @ if
      node dest ->next @ ->prev !
   else
      parent if  node parent ->last ! then  then
   node dest ->next !    parent node ->parent ! ;

: insert-node   ( node dest )
   over remove-node
   dup ->parent @ locals| parent dest node |
   dest ->prev @ node ->prev !   dest node ->next !
   dest ->prev @ if
      node dest ->prev @ ->next !
   else
      parent if  node parent ->first ! then then
   node dest ->prev !    parent node ->parent ! ;


: (init-node)   ( node node -- )
   [[ dup this ->first ! dup this ->last ! dup ->next off dup ->prev off this swap ->parent ! ]] ;

: add-child ( node dest -- )
   locals| dest node |
   dest ->last @ ?dup if
      node swap link-node
      else node dest (init-node) then ;


\ Convenient in debugging
:macro >prev   ->prev @ ;
:macro >next   ->next @ ;
:macro >last   ->last @ ;
:macro >parent   ->parent @ ;
:macro >object   ->object @ ;
:macro >children  ->first @ ;
